home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbinst13 / vbinst.frm < prev    next >
Text File  |  1995-12-05  |  16KB  |  481 lines
  1. VERSION 2.00
  2. Begin Form Install 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Install"
  5.    ClientHeight    =   2745
  6.    ClientLeft      =   1245
  7.    ClientTop       =   2880
  8.    ClientWidth     =   7245
  9.    Height          =   3150
  10.    Icon            =   VBINST.FRX:0000
  11.    Left            =   1185
  12.    LinkMode        =   1  'Source
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   2745
  15.    ScaleWidth      =   7245
  16.    Top             =   2535
  17.    Width           =   7365
  18.    Begin DirListBox Dir1 
  19.       Height          =   315
  20.       Left            =   2175
  21.       TabIndex        =   3
  22.       Top             =   2325
  23.       Visible         =   0   'False
  24.       Width           =   915
  25.    End
  26.    Begin CommandButton Cmd_Start 
  27.       Caption         =   "&Start"
  28.       Default         =   -1  'True
  29.       Height          =   540
  30.       Left            =   6150
  31.       TabIndex        =   8
  32.       Top             =   2025
  33.       Width           =   990
  34.    End
  35.    Begin CheckBox Check1 
  36.       BackColor       =   &H00C0C0C0&
  37.       Caption         =   "&OK to create?"
  38.       ForeColor       =   &H00000000&
  39.       Height          =   390
  40.       Left            =   150
  41.       TabIndex        =   10
  42.       Top             =   2025
  43.       Width           =   1890
  44.    End
  45.    Begin CommandButton Cmd_Cancel 
  46.       Cancel          =   -1  'True
  47.       Caption         =   "&Cancel"
  48.       Height          =   540
  49.       Left            =   6150
  50.       TabIndex        =   7
  51.       Top             =   1350
  52.       Width           =   990
  53.    End
  54.    Begin ListBox List1 
  55.       BackColor       =   &H00C0C0C0&
  56.       ForeColor       =   &H00000000&
  57.       Height          =   1005
  58.       Left            =   2250
  59.       TabIndex        =   4
  60.       Top             =   1275
  61.       Width           =   3090
  62.    End
  63.    Begin Frame Fr_Dest 
  64.       Caption         =   "D&estination SubDirectory"
  65.       Height          =   660
  66.       Left            =   3525
  67.       TabIndex        =   6
  68.       Top             =   75
  69.       Width           =   3015
  70.       Begin TextBox Txt_Dest 
  71.          ForeColor       =   &H00000000&
  72.          Height          =   315
  73.          Left            =   75
  74.          TabIndex        =   0
  75.          Top             =   300
  76.          Width           =   2865
  77.       End
  78.    End
  79.    Begin Frame Fr_Drive 
  80.       BackColor       =   &H00C0C0C0&
  81.       Caption         =   "&Destination Disk"
  82.       Height          =   660
  83.       Left            =   675
  84.       TabIndex        =   1
  85.       Top             =   75
  86.       Width           =   2760
  87.       Begin DriveListBox Drive1 
  88.          ForeColor       =   &H00000000&
  89.          Height          =   315
  90.          Left            =   75
  91.          TabIndex        =   2
  92.          Top             =   300
  93.          Width           =   2295
  94.       End
  95.    End
  96.    Begin Label Label1 
  97.       BackColor       =   &H00C0C0C0&
  98.       Caption         =   "Do you want install to create own Program Manager Group?"
  99.       ForeColor       =   &H00000000&
  100.       Height          =   615
  101.       Left            =   150
  102.       LinkTimeout     =   10
  103.       TabIndex        =   9
  104.       Top             =   1350
  105.       Width           =   1890
  106.    End
  107.    Begin Label Lbl_List 
  108.       Alignment       =   2  'Center
  109.       BackColor       =   &H00C0C0C0&
  110.       Height          =   315
  111.       Left            =   1500
  112.       TabIndex        =   5
  113.       Top             =   900
  114.       Visible         =   0   'False
  115.       Width           =   4515
  116.    End
  117. End
  118.  
  119. Function CheckDir (Chk As Integer) As Integer
  120.  
  121. '**********************************************************************
  122. '* Check destination directory, that it does not exceed allowed       *
  123. '* 11 characters (8+3).If user gives directory such as "..\myprogram",*
  124. '* which has 9 characters in body part, Visual Basic does not         *
  125. '* generate an error code. VB just cut chrs exceeding 8 limit from    *
  126. '* left. So "..\myprogram " would be "..\myprogra", but in Program    *
  127. '* Manager Group item path is still "..\myprogram ", which would cause*
  128. '* error runing the istalled program.                                 *
  129.  
  130. '* To find first "\" (backslash) from right,                          *
  131. '* we need to examine destination path string in reverse order        *
  132. '* For example "D:\WINDOWS\VBINST" would be "TSNIBV\SWODNIW\:D".      *
  133. '* Now we can use InStr function to find first occurence of "\"       *
  134. '* in destination path and check the destination directory.                                               *
  135. '**********************************************************************
  136.     
  137.     DirLen% = Len(Txt_Dest.Text)
  138.     For J% = DirLen% To 1 Step -1
  139.     Temp$ = Mid$(Txt_Dest.Text, J%, 1)
  140.     Directory$ = Directory$ + Temp$
  141.     Next
  142.     
  143.     'Get destination SubDirectory string
  144.     'Get directory's extension if exist
  145.     'Get directory's bodypart
  146.     Directory$ = Left$(Directory$, (InStr(Directory$, "\")))
  147.     Extension% = InStr(Directory$, ".")
  148.     BodyPart% = InStr(Directory$, "\") - Extension%
  149.     'Check extension to not exceed 3 chrs
  150.     If (Extension% = 0 Or Extension% < 5) Then
  151.     'if not extension exceed 3, check bodypart to not exceed 8 chrs
  152.     If BodyPart% > 9 Then
  153.        Chk = 0
  154.     Else
  155.         Chk = 2
  156.     End If
  157.     Else
  158.        Chk = 1
  159.     End If
  160. End Function
  161.  
  162. Sub Cmd_Cancel_Click ()
  163. Const IDYES = 6  'define msgbox return value
  164.     
  165. If Cmd_Cancel.Caption = "&Cancel" Then
  166.     Msg$ = "Are you sure you want to cancel install?"  'give the user a second change
  167.     Title$ = "CANCEL???"
  168.     Response% = MsgBox(Msg$, 292, Title$)  ' Get user response. '36+4+256
  169.     If Response% = IDYES Then   ' Evaluate response
  170.     End
  171.     Else
  172.     Exit Sub
  173.     End If
  174. Else
  175. End
  176. End If
  177.  
  178. End Sub
  179.  
  180. Sub Cmd_Start_Click ()
  181.  
  182. Dim ErrDirTitle As String
  183. ErrDirTitle$ = "Error creating SubDirectory"
  184.     'Set Flag for checking files overwritφng
  185. WarnFlag = True
  186.  
  187.     'assign drive to DestDrive variable for checking needed free diskspace
  188. DestDrive$ = Left$(LCase$(Txt_Dest.Text), 1)
  189.     'see Function NeedSpace in general section
  190. RetValue% = NeedSpace(Chk%)
  191. If Chk% = False Then Exit Sub 'not enough diskspace
  192.  
  193.     'Check destination directory's number of characters.
  194.     'See Function CheckDir in general procedure
  195. RetValue% = CheckDir(Chk%)
  196.  
  197.  
  198. If Chk% = 0 Then
  199.     Msg$ = "Directory's bodypart exceeded 8 characters"
  200.     MsgBox Msg$, 16, ErrDirTitle$
  201.     Txt_Dest.Text = LCase$(LoadDir$) 'change back to default dir drive
  202.     Exit Sub
  203. ElseIf Chk% = 1 Then
  204.     Msg$ = "Directory's extension exceeded 3 characters"
  205.     MsgBox Msg$, 16, ErrDirTitle$
  206.     Txt_Dest.Text = LCase$(LoadDir$) 'change back to default dir drive
  207.     Exit Sub
  208. End If
  209.  
  210.  
  211. On Error Resume Next         'Set up error handling.
  212. DestDir$ = LCase$(Txt_Dest.Text) 'Make path specification.
  213. twobs% = InStr(DestDir$, "\\") 'check if user has put accidently two backslash
  214. If twobs% <> 0 Then            'into subdirectory's name
  215.     Msg$ = "SubDirectory has 2 (\\) backslash! "
  216.     MsgBox Msg$, 16, ErrDirTitle$
  217.     Txt_Dest.Text = LCase$(LoadDir$) 'change back to default dir drive
  218.     Drive1.Drive = Left$(WD$, 1)
  219.     Exit Sub
  220. Else
  221.     ChDir DestDir$           'check if directory already exist
  222.     If Err = 76 Or Err = 0 Then 'see error values
  223.     Err = 0              'reset err
  224.     MkDir DestDir$       'make directory
  225.     If Err = 76 Then    'wrong directory name
  226.         Msg$ = "Could not create such SubDirectory!, Check the SubDirectory's name."
  227.         MsgBox Msg$, 16, ErrDirTitle$
  228.         Txt_Dest.Text = LCase$(LoadDir$) 'change back to default dir drive
  229.         Drive1.Drive = Left$(WD$, 1)
  230.         Exit Sub
  231.     End If
  232.     End If
  233. End If
  234.     'change back to source directory
  235. ChDir SD$
  236.  
  237.     'start installing job
  238. Install.Refresh
  239. Lbl_List.Visible = True
  240. List1.Refresh
  241. Lbl_List.Refresh
  242.  
  243.     'get files from install.inf using GetPrivateProfileString API call
  244.     'to be copied windows system dir
  245. lpApplication$ = "SystemFiles"
  246. lpDefault$ = "EndMark"
  247. lpKeyName$ = "file"
  248. SubDir$ = WSD$
  249. IniCopy lpApplication$, lpKeyName$, lpDefault$, SubDir$
  250.  
  251.     'get files from install.inf using